home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / tpxtable / pxtable.pas < prev    next >
Pascal/Delphi Source File  |  1996-04-08  |  9KB  |  204 lines
  1. unit Pxtable;
  2.  
  3. interface
  4.  
  5. Uses
  6.   DB, DBTables, SysUtils, Classes, DBIProcs, DBITypes, DBIErrs,
  7.   Dialogs, Forms, Controls;
  8.  
  9.  
  10. Type
  11.   { Table type for cascaded master-detail
  12.     delete sequence for Paradox tables }
  13.   TPXTable = Class(TTable)
  14.              Private
  15.                FCheckDelOp : Boolean;
  16.              Public
  17.                Procedure DoBeforeDelete; Override;
  18.              Published
  19.                { False = don't check the table's cascaded delete property:
  20.                          always delete detail records
  21.                  True  = delete detail records if the table's cascaded
  22.                          delete property is RintCascade
  23.  
  24.                  Don't set this property to True - I don't know why,
  25.                  but the cascaded delete property of the master tables is
  26.                  never RintCascade... }
  27.                Property CheckDelOp : Boolean Read FCheckDelOp Write FCheckDelOp Default False;
  28.              End;
  29.  
  30. { Registration procedure }
  31. Procedure Register;
  32.  
  33. implementation
  34.  
  35. { New DoBeforeDelete method }
  36. Procedure TPXTable.DoBeforeDelete;
  37.  
  38.   { Recursively deletes cascaded records in related tables }
  39.   Procedure DeleteDetailRecords(DataBaseHandle  : hDBIDb;     { Database cursor }
  40.                                 MasterHandle    : hDBICur;    { Master table cursor }
  41.                                 MasterTableName : TFileName); { Master table name }
  42.     { Some variables are unnecessary, but the code is readable... }
  43.     Var
  44.       { RintXXX - referential integrity variables }
  45.       RintCur       : HDBICur;   { Rint table cursor handle }
  46.       RintProps     : CurProps;  { Rint table properties }
  47.       RintRec       : PRintDesc; { Rint record buffer }
  48.       RintEof       : Boolean;   { True = end of Rint table }
  49.       { MstXXX - master table variables }
  50.       MstCur        : HDBICur;   { Cloned master table cursor handle }
  51.       MstName       : DBIPath;   { Null terminated name of the master table }
  52.       MstFields     : DBIKey;    { Rint fields in master table }
  53.       { DetXXX - detail table variables }
  54.       DetCur        : HDBICur;   { Detail table cursor handle }
  55.       DetName       : DBIPath;   { Null terminated name of the detail table }
  56.       DetFields     : DBIKey;    { Rint fields in detail table }
  57.       DetRecCount   : LongInt;   { Number of detail records }
  58.       DetIdxCount   : Word;      { Number of detail indexes }
  59.       DetIdx        : Word;      { Detail table index number for DBIOpenTable }
  60.       DetIdxDesc    : IdxDesc;   { Detail table index descriptor }
  61.       DetFieldCount : Word;      { Counts detail table fields to find the detail index }
  62.       DetProps      : CurProps;  { Detail table properties }
  63.       DetIdxFound   : Boolean;   { True = detail index found }
  64.       LinkFields    : Word;      { Number of linked fields }
  65.       { Other variables }
  66.       Rslt          : DBIResult; { DBI result }
  67.       I,J           : Integer;   { For searching the detail index }
  68.     Begin
  69.       { Store master table name in null terminated format }
  70.       StrPCopy(MstName,MasterTableName);
  71.       { Open Rint table }
  72.       Check(DBIOpenRintList(DataBaseHandle,MstName,szPARADOX,RintCur));
  73.       { Get Rint table properties to get the Rint record size }
  74.       DBIGetCursorProps(RintCur,RintProps);
  75.       Try
  76.         { Allocate Rint record buffer }
  77.         GetMem(RintRec,RintProps.iRecBufSize);
  78.         { Get the next Rint record }
  79.         While DBIGetNextRecord(RintCur,dbiNoLock,RintRec,Nil) = 0 Do
  80.           { If this table is master and cascaded delete enabled then continue }
  81.           If (RintRec^.eType = RintMaster) And ((RintRec^.eDelOp = RintCascade) Or Not FCheckDelOp) Then
  82.             Begin
  83.               { Save Rint record fields }
  84.               StrCopy(DetName,RintRec^.szTblName);
  85.               MstFields := RintRec^.aiThisTabFld;
  86.               DetFields := RintRec^.aiOthTabFld;
  87.               LinkFields := RintRec^.iFldCount;
  88.               {------------------------------------------------------------}
  89.               { Determining detail index for DBILinkDetail }
  90.               Check(DBIOpenTable(DataBaseHandle,DetName,szPARADOX,
  91.                     Nil,Nil,0,DBIReadWrite,DBIOpenShared,xltNone,
  92.                     False,Nil,DetCur));
  93.               Try
  94.                 { Get detail table properties }
  95.                 Check(DBIGetCursorProps(DetCur,DetProps));
  96.                 DetIdxCount := DetProps.iIndexes;
  97.                 DetIdx := 1;
  98.                 DetIdxFound := False;
  99.                 While (DetIdx <= DetIdxCount) And Not DetIdxFound Do
  100.                   Begin
  101.                     { Get detail table index descriptor }
  102.                     Check(DBIGetIndexDesc(DetCur,DetIdx,DetIdxDesc));
  103.                     DetFieldCount := 0;
  104.                     For I := 0 To LinkFields-1 Do
  105.                       For J := 0 To LinkFields-1 Do
  106.                          If DetIdxDesc.aiKeyFld[J] = DetFields[I] Then
  107.                            Inc(DetFieldCount);
  108.                     DetIdxFound := DetFieldCount >= LinkFields;
  109.                     If DetIdxFound
  110.                     Then
  111.                       DetIdx := DetIdxDesc.iIndexId
  112.                     Else
  113.                       Inc(DetIdx);
  114.                   End;
  115.               Finally
  116.                 DBICloseCursor(DetCur);
  117.               End;
  118.               {------------------------------------------------------------}
  119.  
  120.               { Open detail table }
  121.               Check(DBIOpenTable(DataBaseHandle,DetName,szPARADOX,
  122.                     Nil,Nil,DetIdx,DBIReadWrite,DBIOpenShared,xltNone,
  123.                     False,Nil,DetCur));
  124.               Try
  125.                 { Open secondary master table }
  126.                 Check(DBIOpenTable(DataBaseHandle,MstName,szPARADOX,
  127.                       Nil,Nil,0,DBIReadOnly,DBIOpenShared,xltNone,
  128.                       False,Nil,MstCur));
  129.                 { Setup cursors for link link mode and establish link }
  130.                 Check(DBIBeginLinkMode(DetCur));
  131.                 Check(DBIBeginLinkMode(MstCur));
  132.                 Check(DBILinkDetail(MstCur,DetCur,LinkFields,@MstFields,@DetFields));
  133.                 Try
  134.                   { Update secondary master cursor }
  135.                   Check(DBISetToCursor(MstCur,MasterHandle));
  136.                   Check(DBIGetRecord(MstCur,DBINoLock,Nil,Nil));
  137.                   Check(DBISetToBegin(DetCur));
  138.                   Check(DBIGetRecordCount(DetCur,DetRecCount));
  139.                   { Delete related records if they exists }
  140.                   If DetRecCount > 0 Then
  141.                     While DBIGetNextRecord(DetCur,dbiNoLock,Nil,Nil) = 0 Do
  142.                       Begin
  143.                         { Delete subsequent detail records }
  144.                         DeleteDetailRecords(DataBaseHandle,DetCur,StrPas(DetName));
  145.                         { Delete detail record }
  146.                         Check(DBIDeleteRecord(DetCur,Nil));
  147.                      End;
  148.                 Finally
  149.                   { Unlink tables and restore cursors to normal mode }
  150.                   DBIUnlinkDetail(DetCur);
  151.                   DBIEndLinkMode(DetCur);
  152.                   DBIEndLinkMode(MstCur);
  153.                 End;
  154.               Finally
  155.                 { Close table cursors }
  156.                 DBICloseCursor(MstCur);
  157.                 DBICloseCursor(DetCur);
  158.               End;
  159.             End;
  160.       Finally
  161.         { Release Rint record buffer and close Rint cursor }
  162.         FreeMem(RintRec,RintProps.iRecBufSize);
  163.         DBICloseCursor(RintCur);
  164.       End;
  165.     End;
  166.  
  167.   { DoBeforeDelete statement block }
  168.   Begin
  169.     { Execute inherited DoBeforeDelete }
  170.     Inherited DoBeforeDelete;
  171.  
  172.     { Cascaded delete occurs if the type of the table is Paradox.
  173.       The type of the table is Paradox, if the TableType property is
  174.       ttParadox or ttDefault and the file extension is '.DB' or empty }
  175.     If (TableType = ttParadox) Or
  176.        (TableType = ttDefault) And ((ExtractFileExt(TableName) = '.DB') Or (ExtractFileExt(TableName) = '')) Then
  177.       Begin
  178.         { Update table cursor }
  179.         UpdateCursorPos;
  180.         Try
  181.           Try
  182.             { Set screen cursor to hourglass }
  183.             Screen.Cursor := crHourGlass;
  184.             { Delete cascaded records }
  185.             DeleteDetailRecords(DataBase.Handle,Handle,TableName);
  186.           Finally
  187.             { Restore screen cursor to default }
  188.             Screen.Cursor := crDefault;
  189.           End;
  190.         Except
  191.           Raise;
  192.         End;
  193.       End;
  194.   End;
  195.  
  196. { Registration procedure }
  197. Procedure Register;
  198.   Begin
  199.     RegisterComponents('Data Access',[TPXTable]);
  200.   End;
  201.  
  202. end.
  203.  
  204.